home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / ttlps / ttlphoto.ctl < prev   
Text File  |  1999-08-17  |  16KB  |  468 lines
  1. VERSION 5.00
  2. Begin VB.UserControl TTLSlide 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00808080&
  5.    ClientHeight    =   2505
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   2505
  9.    ClipControls    =   0   'False
  10.    EditAtDesignTime=   -1  'True
  11.    FillColor       =   &H00808080&
  12.    FillStyle       =   0  'Solid
  13.    KeyPreview      =   -1  'True
  14.    ScaleHeight     =   2505
  15.    ScaleWidth      =   2505
  16.    ToolboxBitmap   =   "TTLPHO~1.ctx":0000
  17.    Begin VB.Frame FrameView 
  18.       BackColor       =   &H00808080&
  19.       BorderStyle     =   0  'None
  20.       Height          =   3855
  21.       Left            =   0
  22.       TabIndex        =   0
  23.       ToolTipText     =   "TTL Slide Frame"
  24.       Top             =   0
  25.       Visible         =   0   'False
  26.       Width           =   3855
  27.       Begin VB.Image Image2 
  28.          BorderStyle     =   1  'Fixed Single
  29.          Height          =   255
  30.          Left            =   5280
  31.          Top             =   5880
  32.          Width           =   255
  33.       End
  34.       Begin VB.Image Image1 
  35.          BorderStyle     =   1  'Fixed Single
  36.          Height          =   2775
  37.          Left            =   -120
  38.          Top             =   5760
  39.          Visible         =   0   'False
  40.          Width           =   135
  41.       End
  42.    End
  43. End
  44. Attribute VB_Name = "TTLSlide"
  45. Attribute VB_GlobalNameSpace = False
  46. Attribute VB_Creatable = True
  47. Attribute VB_PredeclaredId = False
  48. Attribute VB_Exposed = False
  49. Option Explicit
  50. 'Default Property Values:
  51. Const m_def_ToolTipText = ""
  52. 'Const m_def_ForeColor = 0
  53. Const m_def_Enabled = 0
  54. Const m_def_BackStyle = 0
  55. Const m_def_BorderStyle = 0
  56. 'Const m_def_ToolTipText = ""
  57. Const m_def_WhatsThisHelpID = 0
  58. 'Property Variables:
  59. Dim m_ToolTipText As String
  60. 'Dim m_ForeColor As Long
  61. Dim m_Enabled As Boolean
  62. Dim m_BackStyle As Integer
  63. Dim m_BorderStyle As Integer
  64. 'Dim m_ToolTipText As String
  65. Dim m_WhatsThisHelpID As Long
  66. Dim isSlide As Boolean
  67. 'Event Declarations:
  68. Event Click() 'MappingInfo=Image2,Image2,-1,Click
  69. Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
  70. Event DblClick() 'MappingInfo=Image2,Image2,-1,DblClick
  71. Attribute DblClick.VB_Description = "Occurs when the user presses and releases a mouse button and then presses and releases it again over an object."
  72. Event KeyDown(KeyCode As Integer, Shift As Integer)
  73. Attribute KeyDown.VB_Description = "Occurs when the user presses a key while an object has the focus."
  74. Event KeyPress(KeyAscii As Integer)
  75. Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
  76. Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyUp
  77. Attribute KeyUp.VB_Description = "Occurs when the user releases a key while an object has the focus."
  78. Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Image2,Image2,-1,MouseDown
  79. Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
  80. Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Image2,Image2,-1,MouseMove
  81. Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
  82. Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  83. Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."
  84. Event Show() 'MappingInfo=UserControl,UserControl,-1,Show
  85. Attribute Show.VB_Description = "Occurs when the control's Visible property changes to True."
  86.  
  87.  
  88. Private Sub TTLSlide_Resize()
  89.  
  90.     Dim iW As Double, iH As Double
  91.     
  92.     FrameView.Top = 0
  93.     FrameView.Left = 0
  94.     If Width > Height Then
  95.         FrameView.Width = Height
  96.     Else
  97.         FrameView.Width = Width
  98.     End If
  99.         
  100.     FrameView.Height = FrameView.Width
  101.     Width = FrameView.Width
  102.     Height = FrameView.Height
  103.                 
  104. End Sub         '** TTLSlide_Resize
  105.  
  106.  
  107. Public Function LoadImage(strImg As String, bSlide As Boolean) As Boolean
  108.  
  109.     Dim iW As Double, iH As Double, iRespond As Integer
  110.  
  111.     LoadImage = True
  112.     isSlide = bSlide
  113.     
  114.     '** User load nothing
  115.     If strImg = "" Then
  116.         Image1.Picture = Nothing
  117.         Image2.Picture = Nothing
  118.         Image1.Visible = False
  119.         Image2.Visible = False
  120.         Exit Function
  121.     End If
  122.     
  123.     If Not FrameView.Visible Then
  124.         FrameView.Visible = True
  125.     End If
  126.     
  127.     On Error GoTo ImageChoiceErr
  128.     
  129.     If FrameView.Width <> Width Or FrameView.Height <> Height Then
  130.         TTLSlide_Resize
  131.     End If
  132.     
  133.     '** Check which image to be use
  134.     If Image1.Visible Then
  135.         Image2.Stretch = False
  136.         Image2.Picture = LoadPicture(strImg)
  137.         Image2.ToolTipText = strImg
  138.         iW = Image2.Picture.Width
  139.         iH = Image2.Picture.Height
  140.         '** Resize Image to fit in frame View
  141.         ImgResize 2, iW, iH
  142.     Else
  143.         Image1.Stretch = False
  144.         Image1.Picture = LoadPicture(strImg)
  145.         Image1.ToolTipText = strImg
  146.         iW = Image1.Picture.Width
  147.         iH = Image1.Picture.Height
  148.         ImgResize 1, iW, iH
  149.     End If
  150.  
  151.     Exit Function
  152.  
  153. ImageChoiceErr:
  154.     LoadImage = False
  155.     MsgBox "Photo Slide can not display this type of image." & Chr(13) & _
  156.             "Please check the image's format.", vbCritical, "Error Loading Image"
  157.     Exit Function
  158.  
  159. End Function        '** LoadImage
  160.  
  161.  
  162.  
  163. Private Sub ImgResize(imgNum, iW, iH)
  164.  
  165.  
  166.     Dim iMove As Double, iLeft As Double
  167.  
  168.     If imgNum = 1 Then
  169.     
  170.         Image1.Visible = False                          '** Hide while resize
  171.         Image1.Stretch = True
  172.                         
  173.         '** Calculate Width and Height
  174.         If iW > iH Then
  175.             Image1.Width = FrameView.Width * 0.9
  176.             Image1.Height = (Image1.Width * (iH / iW))
  177.             Image1.Left = FrameView.Width * 0.05
  178.             Image1.Top = (FrameView.Height - Image1.Height) / 2
  179.         Else
  180.             Image1.Height = FrameView.Width * 0.9
  181.             Image1.Width = (Image1.Height * (iW / iH))
  182.             Image1.Top = FrameView.Width * 0.05
  183.             Image1.Left = (FrameView.Width - Image1.Width) / 2
  184.         End If
  185.         
  186.         Image1.Visible = True
  187.         '** If image view in normal size, then use slide in feature
  188.         If isSlide Then
  189.             If Width < 7400 Then
  190.                 iLeft = Image1.Left
  191.                 iMove = Width
  192.                 Do While iMove > 0
  193.                     iMove = iMove - 50
  194.                     
  195.                     Image1.Left = iMove
  196.                     If Image1.Left < iLeft Then
  197.                         Image1.Left = iLeft
  198.                         Exit Do
  199.                     End If
  200.                 Loop
  201.             End If
  202.         End If
  203.         '***************************
  204.         Image2.Visible = False
  205.         
  206.     Else
  207.     
  208.         Image2.Visible = False                          '** Hide while resize
  209.         Image2.Stretch = True
  210.         
  211.         '** Calculate Width and Height
  212.         If iW > iH Then
  213.             Image2.Width = FrameView.Width * 0.9
  214.             Image2.Height = (Image2.Width * (iH / iW))
  215.             Image2.Left = FrameView.Width * 0.05
  216.             Image2.Top = (FrameView.Height - Image2.Height) / 2
  217.         Else
  218.             Image2.Height = FrameView.Height * 0.9
  219.             Image2.Width = (Image2.Height * (iW / iH))
  220.             Image2.Top = FrameView.Width * 0.05
  221.             Image2.Left = (FrameView.Width - Image2.Width) / 2
  222.         End If
  223.         Image2.Visible = True
  224.             
  225.         '** If image view in normal size, then use slide in feature
  226.         If isSlide Then
  227.             If Width < 7400 Then
  228.                 iLeft = Image2.Left
  229.                 iMove = -Image2.Left
  230.                 
  231.                 Do While iMove <= iLeft
  232.                     iMove = iMove + 50
  233.                     Image2.Left = iMove
  234.                     
  235.                     If Image2.Left > iLeft Then
  236.